home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 26.zip / BS1 part 26 / The Director Toolkit v1.0.adf / BlitUtil / ebuscript < prev    next >
Text File  |  1987-02-25  |  33KB  |  1,183 lines
  1.  
  2. rem  enhanced blit utility 
  3. rem Copyright 1988, Right Answers, All Rights Reserved
  4. rem This script is provided for educational purposes or
  5. rem ehancement by the original Director ToolKit owner only.
  6. rem no part of this script or it's .film file are to
  7. rem be distributed. 
  8.  
  9. rem  NOTE: if you decide to modify or re-run this script through
  10. rem  the Director for some reason, note that it is designed to be run 
  11. rem  from an ASSIGNIT icon, which assigns HERE: to the current directory.
  12. rem  When you run the Director directly on this script, the HERE: will 
  13. rem  have not been assigned, and you will get an error.  However, the
  14. rem  .film file will have then been correctly generated, and you
  15. rem  will then be able to run the Enhanced Blit Utility from the
  16. rem  CLI by typing the name of the ASSIGNIT program (EBU) or clicking
  17. rem  on it's icon as usual.  The changes you have made will have taken
  18. rem  effect.  When working on scripts that are designed to be run from
  19. rem  the ASSIGNIT program, it can be helpful to assign HERE: to your
  20. rem  working Directory. 
  21.  
  22. rem  The following values are used in determining the screen centering
  23. rem  127,43 are correct for NTSC, PAL screens should be 127,??
  24. rem  make the Y number larger to move the screen down, smaller to
  25. rem  move up.  You could also adjust these to compensate for 
  26. rem  "morerows" adjusted preferences.
  27.  
  28. ScreenX=127
  29. ScreenY=43  :rem  adjust this for PAL centering
  30. NormHt=200
  31.  
  32. setblack 1
  33.  
  34. rem *** important routine names ***
  35.     menua=1000:checkbot=2000:getbuff=3000:getfile=4000:strend=5000
  36.     fileout=6000:yesno=5010:getbrush=7000:chkmain=2100
  37.     genblit=7100:genmove=7200:genchar=7300:centscr=7400
  38.     placbrsh=7500:outblit=7600:putbrush=7700:initfils=7800
  39.     saveobj=7900:doread=8000:errmsg=8100
  40.  
  41. fnamesz=100
  42.     charsiz=7            :rem  preserve char blit parameters, x,y,x,y,w,h etc.
  43.     totchars=50            :rem  max number of character frames allowed
  44.     totfiles=20            :rem  number of remembered object files
  45.     filentsz=fnamesz+2    :rem  buffer #, used flag, filename 
  46.  
  47. rem  array locations
  48.     tname=0
  49.     bkgname=tname+fnamesz
  50.     objname=bkgname+fnamesz
  51.     outname=objname+fnamesz
  52.     postfix=outname+fnamesz+1
  53.     temp=postfix+fnamesz-1
  54.     title=temp
  55.     quote=temp+fnamesz
  56.     filent=quote+4
  57.     charbase=filent+filentsz*totfiles
  58.     charbend=charbase+charsiz*totchars
  59.     array charbend+1,2
  60.  
  61.     mode=0:open mode,"here:screeny"
  62.     if mode
  63.         read mode,$(0),20
  64.         NormHt=$(0)
  65.         read mode,$(0),20
  66.         ScreenY=$(0)
  67.         close
  68.     endif
  69.  
  70.     gosub initfils        :rem   initialize remembered object files
  71.  
  72. rem  file req is assumed to have been put in ram by the ASSIGNIT icon.
  73.  
  74.     mode=0
  75.     open mode,"ram:filereq"
  76.     close
  77.     if mode=0
  78.         print "Error: Can't find file 'filereq'"
  79.         end
  80.     endif
  81.  
  82. rem  variable initializations
  83.     transon=0        :rem  blit transparent flag
  84.     conton=0        :rem  continuous move flag
  85.     btype=0            :rem  blit/diss/wipe type flag
  86.     firstmv=1        :rem  move counter
  87.     cancel=0
  88.     brselect=0
  89.     charf=0
  90.     helpa=0
  91.     oback=0
  92.     appmode=0
  93.     overscan=0
  94.     firstopn=1
  95.     newback=1
  96.     fname=0:space=32:colon=58:slash=47
  97.     aspeed=0
  98.  
  99.     @(quote)=34
  100.     @(quote+1)=0
  101.     string "ram:ebuout",$(outname)
  102.     @(bkgname)=0:@(objname)=0:@(postfix)=0:@(postfix-1)=colon
  103.  
  104.     savebuff=10:screen=1:bkgbuf=0:objbuf=0:altbuf=4:objused=0
  105.     load screen,"here:buscreen1"
  106.     load savebuff,"here:buscreen2"
  107.     display savebuff:free screen
  108.  
  109.     abort 0
  110.  
  111.     blits=0:moves=0:obuff=3:bbuff=1
  112.  
  113.     gosub menua
  114.  
  115. abort 1
  116. pointer 1
  117. 10    pause 10:goto 10
  118.  
  119. rem  menua:
  120. 1000
  121.     new screen,savebuff
  122.     copy savebuff,screen
  123.     display screen:gosub centscr
  124.     pen 1,1:rect 137,174,256,194    :rem  clear stuff
  125.     setblack 0
  126.  
  127. 1001
  128.     blit savebuff,0,0,0,0,320,112        :rem restore upper screen
  129.     gosub 1100    :rem  restore lower screen
  130.     getmouse xm,ym
  131.     gosub checkbot
  132.     gosub chkmain
  133.     goto 1001    :rem  redisplay
  134.  
  135. rem  redisplay lower screen
  136. 1100
  137.     pen 1,1
  138.     rect 8,126,311,134
  139.     rect 8,150,311,158
  140.     rect 118,162,311,172
  141.  
  142.     pen 0,1:pen 1,2:center 0:drawmode 1
  143.     move 67,183:text blits;
  144.     if blits=0:text " ";:endif
  145.     move 67,192:text moves;
  146.     if moves=0:text " ";:endif
  147.  
  148.     center 1:pen 1,3
  149.     move 0,133:if @(bkgname):text $(bkgname):else:text "none";:endif
  150.     move 0,157:if @(objname):text $(objname):else:text "none";:endif
  151.     margins 118,311:move 0,170:text $(outname)
  152.  
  153.     margins -1,-1:center 0
  154.     move 276,122:text bbuff;" ";
  155.     move 276,146:text obuff;" ";
  156.     move 93,183
  157.     if appmode
  158.         text "*";
  159.     else
  160.         text " ";
  161.     endif
  162.     return
  163.  
  164. rem  checkbot:
  165. 2000
  166.     center 0
  167.     if ym<113:return:endif
  168.     if ym>177 & ym<191 & xm>259 & xm<312    :rem  done signaled
  169.  
  170.         if firstmv#1
  171.             gosub fileout
  172.             write
  173.             write " goto 10     :rem  end of text generated by BLITUTIL"
  174.             write
  175.             close
  176.         endif
  177.  
  178.         if fname:execute a,"c:delete ram:fname":endif
  179.         end
  180.     endif
  181.     if ym<136
  182.         if ym < 125 & xm > 208
  183.             by=122:gosub getbuff
  184.         else
  185.             string "Load Background Image",$(title)
  186.             name=bkgname:t=0
  187.             if @(name)=0:string $(objname),$(bkgname):t=1:endif
  188.             gosub getfile:if t & fname=0:@(name)=0:endif
  189.             if fname 
  190.                 bkgbuf=2
  191.                 free bkgbuf
  192.                 load bkgbuf,$(bkgname)
  193.                 newback=1
  194.             endif
  195.         endif
  196.         return
  197.     endif
  198.     if ym<160
  199.         if ym < 149 & xm > 208
  200.             by=146:gosub getbuff
  201.         else
  202.             if objused 
  203.                 gosub saveobj
  204.             endif
  205.             brselect=0
  206.             string "Load Object Image",$(title)
  207.             name=objname:t=0
  208.             if @(name)=0:string $(bkgname),$(objname):t=1:endif
  209.             gosub getfile:if t & fname=0:@(name)=0:endif
  210.             if fname 
  211.                 objbuf=3
  212.                 free objbuf
  213.                 load objbuf,$(objname)
  214.  
  215.                 j=1
  216.                 for i=0 to totfiles-1
  217.                     compare v,$(objname),$(filent+i*filentsz+2)
  218.                     if v:j=0:obuff=@(filent+i*filentsz):endif
  219.                 next
  220.                 if j
  221.  
  222. rem  pick new obj buff
  223. 2007                i=0
  224. 2008                if i#totfiles
  225.                         j=filent+i*filentsz
  226.                         if @(j)=obuff
  227.                             obuff=obuff+1
  228.                             goto 2007        :rem  found it, start over
  229.                         endif
  230.                         i=i+1
  231.                         goto 2008
  232.                     endif
  233.  
  234.                 endif
  235.             endif
  236.         endif
  237.         return
  238.     endif
  239.     if ym<173
  240. 2001        pen 1,1:rect 118,162,311,172
  241.             pen 1,3:move 118,170:input $(outname),50 
  242.             if @(outname)=0:goto 2001:endif
  243.             return
  244.     endif
  245.     if ym>176 & ym<184 & xm>101 & xm<134        :rem  append button
  246.         appmode=1-appmode
  247.         return
  248.     endif
  249.     if ym>186 & ym<194 & xm>101 & xm<134        :rem  clear button
  250.         blit savebuff,137,174,137,174,120,22    :rem  get xtra buttons
  251.         gosub yesno
  252.         pen 1,1:rect 137,174,256,194    :rem  clear stuff when done
  253.         if choice
  254.             mode=1:open mode,$(outname):close:moves=0:blits=0
  255.         endif
  256.     endif
  257.     return
  258.  
  259. rem  chkmain  -- check upper buttons
  260. 2100
  261.     if ym>112:return:endif    :rem  not upper buttons
  262.     if xm>27 & xm<293 & ym>56 & ym<74    :rem  blit/dissolve/wipe
  263.         goto genblit
  264.     endif
  265.     if xm>27 & xm<293 & ym>74 & ym<90    :rem  move object
  266.         goto genmove
  267.     endif
  268.     if xm>27 & xm<293 & ym>90 & ym<106    :rem  gen a character
  269.         goto genchar
  270.     endif
  271.     return
  272.  
  273. rem  getbuff    - get new buffer number
  274. 3000
  275.     move 276,by
  276.     pen 0,1:pen 1,3
  277.     input $(temp),3
  278.     move 276,by
  279.     if by=122
  280.         bbuff=$(temp)
  281.         text bbuff;" ";
  282.     else
  283.         obuff=$(temp)
  284.         text obuff;" ";
  285.     endif
  286.     return
  287.  
  288. rem  getfile
  289. rem  returns file name in  $(name), must be initialized with either
  290. rem  @(name)=0, or with default file name
  291. rem  gets requester title from $(title), $(title) must have space
  292. rem  for 100 characters max.
  293. rem  uses strend routine (5000) to find end of strings
  294.  
  295. 4000
  296.     strend=5000
  297. rem  build file requester command, putting quotes around text
  298.     string $(title),$(title+50)
  299.     string "ram:filereq ",$(title)
  300.     @(title+12)=@(quote)
  301.     string $(title+50),$(title+13)
  302.     se=title+13:gosub strend
  303.     @(se)=@(quote)
  304.     if @(name)        :rem  preserve last directory
  305.         @(se+1)=space
  306.         @(se+2)=@(quote)
  307.         string $(name),$(se+3)
  308.         gosub strend
  309. rem  backup to find : or /
  310. 4001    if @(se)#colon & @(se)#slash:se=se-1:goto 4001:endif
  311.         if @(se)=colon:se=se+1:endif
  312.         @(se)=@(quote)
  313.     endif
  314.     @(se+1)=0        :rem  terminate string
  315.     execute a,$(title)
  316.     mode=0:open mode,"ram:fname":fname=mode
  317.     if mode
  318.         read a,$(name),98
  319.         close
  320.     endif
  321.     return
  322.  
  323. rem  strend
  324. 5000 if @(se):se=se+1:goto 5000:endif
  325.     return
  326.  
  327. rem  yesno
  328. 5010
  329.     getmouse xm,ym
  330.     if xm>238 & xm<254 & ym>176 & ym<184
  331.         choice=1
  332.         return
  333.     endif
  334.     if xm>238 & xm<254 & ym>186 & ym<194
  335.         choice=0
  336.         return
  337.     endif
  338. rem  flash y/n
  339.     blitmode 102
  340.     blit savebuff,137,7,239,177,15,17:pause 1
  341.     blit savebuff,137,7,239,177,15,17
  342.     blitmode -1
  343.     goto 5010
  344.     return
  345.  
  346. rem  fileout
  347. 6000
  348.     mode=0:open mode,$(outname)
  349.     close
  350.     if mode
  351.         if firstopn & appmode=0:mode=1:else:mode=2:endif
  352.         open mode,$(outname)
  353.         if mode=0
  354.             print " Can't open output file ";$(outname)
  355.             end
  356.         endif
  357.         seek -1
  358.     else
  359.         mode=1:open mode,$(outname)
  360.         if mode=0
  361.             print " Can't open output file ";$(outname)
  362.             end
  363.         endif
  364.     endif
  365.     firstopn=0
  366.     return
  367.  
  368. rem  getbrush -- cutout a box
  369. 7000
  370.  
  371. rem  pop up file requester if no objbuf...
  372.     cancel=0    :rem just in case
  373.     if objbuf=0:xm=147:ym=151:gosub 2000:endif
  374.     if objbuf=0:cancel=1:return:endif
  375.     display objbuf:gosub centscr
  376.  
  377.     pen 1,31
  378.     drawmode 2     :rem  xor mode
  379.     getmouse x,y
  380.     xa=x:ya=y
  381.     move x+10,y:draw x,y:draw x,y+10
  382.     getmouse xb,yb
  383.     move x+10,y:draw x,y:draw x,y+10
  384.     if xb<x:xa=xb:xb=x:endif
  385.     if yb<y:ya=yb:yb=y:endif
  386.     pointer 1
  387.  
  388. 7087    :rem  draw box
  389.     move xa,ya:draw xa,yb:draw xb,yb:draw xb,ya:draw xa,ya
  390.  
  391. 7088
  392.     pause 1:ifkey char:if char=13|char=32:goto 7089:endif
  393.     ifmouse xt,yt:if xt=-1:goto 7088:endif
  394.  
  395. rem  erase box
  396.     move xa,ya:draw xa,yb:draw xb,yb:draw xb,ya:draw xa,ya
  397.  
  398.     if !(xt-xa)+!(yt-ya) > !(xt-xb)+!(yt-yb):xb=xt:yb=yt
  399.     else:xa=xt:ya=yt:endif
  400.     goto 7087
  401.  
  402. 7089
  403.     pointer 0
  404. rem  erase box
  405.     move xa,ya:draw xa,yb:draw xb,yb:draw xb,ya:draw xa,ya
  406.     drawmode -1
  407.     x=xa:y=ya
  408.     if xb<x:xa=xb:xb=x:endif
  409.     if yb<y:ya=yb:yb=y:endif
  410.     wid=xb-xa:hite=yb-ya
  411.     return
  412.  
  413. rem  genblit
  414. 7100
  415.     gosub 1100    :rem  redisplay lower screen
  416.     pen 1,1:rect 8,57,312,106    :rem  erase upper buttons
  417.     blit savebuff,137,177,8,74,99,16:rect 10,76,104,87    :rem  dissolve
  418.     blit savebuff,137,177,111,74,99,16:rect 113,76,207,87 :rem  blit
  419.     blit savebuff,137,177,214,74,99,16:rect 216,76,310,87 :rem  wipe
  420.     blit savebuff,137,177,8,57,99,16:rect 10,59,104,70    :rem  main
  421.     blit savebuff,137,177,111,57,99,16:rect 113,59,207,70 :rem  pick
  422.     blit savebuff,137,177,214,57,99,16:rect 216,59,310,70 :rem  transp
  423.     pen 1,0
  424.     center 1
  425.     if brselect:pen 1,0:else:pen 1,1:endif :rem  deselect buttons if no brsh
  426.     margins 10,104:move 0,85:text "DISSOLVE"
  427.     margins 113,207:move 0,85:text "BLIT"
  428.     margins 216,310:move 0,85:text "WIPE"
  429.     pen 1,0
  430.     margins 113,207:move 0,67:text "PICK OBJECT"
  431.     margins 10,104:move 0,67:text "Main Menu"
  432.     margins -1,-1:center 0:move 12,106:text "Postfix: ";
  433.     pen 1,1:rect 84,90,314,108        :rem  erase old postfix
  434.     pen 1,3
  435.     if @(postfix)
  436.         text $(postfix);
  437.     else
  438.         text "none";
  439.     endif
  440. 7101
  441.     center 1
  442.     margins 216,310:move 0,67
  443.     if transon:pen 1,3:else:pen 1,0:endif
  444.     text "TRANSPARENT"
  445.     margins -1,-1
  446.     getmouse xm,ym
  447.     gosub checkbot
  448.     x=xm:y=ym
  449.     if x>8 & y>74 & x<102 & y<89    :rem  dissolve
  450.         btype=1
  451.     endif
  452.     if x>111 & y>74 & x<205 & y<89    :rem  blit
  453.         btype=2
  454.     endif
  455.     if x>214 & y>74 & x<308 & y<89    :rem  wipe
  456.         btype=3
  457.     endif
  458.     if x>8 & y>56 & x<102 & y<71    :rem  back to main 
  459.         pen 1,1:rect 8,57,312,106    :rem  erase upper buttons
  460.         return
  461.     endif
  462.     if x>214 & y>56 & x<312 & y<71        :rem  transparent toggle
  463.         transon=1-transon
  464.         goto 7101
  465.     endif
  466.     if x>111 & y>56 & x<205 & y<71    :rem  pick object
  467.         gosub getbrush                :rem  cutout a brush
  468.         display screen:gosub centscr
  469.         gosub 1100                    :rem  redisplay lower screen
  470.         if cancel=0:brselect=1:goto 7100:endif
  471.         goto 7101
  472.     endif
  473.     if y>90 & y<108
  474.         pen 1,1:rect 84,90,314,108        :rem  erase old postfix
  475.         pen 1,3:move 85,106:input $(postfix),40
  476.     endif
  477.     if btype=0:goto 7100:endif
  478.     if brselect=0:goto 7200:endif    :rem  no brush selected
  479.  
  480. rem  gen blit command
  481. rem  first, get brush
  482.  
  483.     outflag=1            :rem  flag write out blits directly
  484.     gosub putbrush        :rem  place down a brush
  485.     btype=0
  486.     goto 7100        :rem  for more
  487.  
  488. rem  putbrush
  489. 7700
  490. rem  now place on background
  491.     display objbuf:gosub centscr     :rem  insure we're on brush screen
  492.     free screen        :rem  we may need the space for second bkgrnd buff.
  493.  
  494. if outflag=2 & bkgbuf=0
  495.     bkgbuf=2
  496.     oback=1            :rem  flag not real background buff
  497.     new bkgbuf,objbuf
  498. endif
  499.  
  500. rem  filerequest for bkground if nonexistant
  501.     if bkgbuf=0:xm=147:ym=130:gosub 2000:endif
  502.     cancel=0
  503.     if bkgbuf=0:cancel=1:goto 7799:endif
  504.     display bkgbuf:gosub centscr    :rem  here's where we go now...
  505.     overscan=os
  506.  
  507. rem  swap stuff into fast memory if possible.....
  508.     memory all,chip,fast
  509.     if fast>50000
  510.         gotfast=1
  511.         newfast 11,savebuff
  512.         copy savebuff,11
  513.         free savebuff
  514.     else:gotfast=0:endif
  515.  
  516.     gosub placbrsh
  517.     if cancel:goto 7798:endif
  518.  
  519.     if outflag=0
  520.         firstxt=outxt
  521.         firstyt=outyt
  522.         gosub placbrsh    :rem  place in second pos.
  523.         if cancel:goto 7798:endif
  524.     endif
  525.  
  526. 7798
  527. rem  restore buffers
  528.     if gotfast
  529.         new savebuff,11
  530.         copy 11,savebuff
  531.         free 11
  532.     endif
  533.  
  534. 7799
  535.     if objbuf
  536.         new screen,savebuff
  537.         copy savebuff,screen
  538.         display screen:gosub centscr
  539.         pen 1,1:rect 137,174,256,194    :rem  clear stuff
  540.     endif
  541.     return
  542.  
  543. rem  genmove
  544. 7200
  545.     gosub 1100    :rem  redisplay lower screen
  546.     pen 1,1:rect 8,57,312,106    :rem  erase upper buttons
  547.     blit savebuff,137,177,8,57,99,16:rect 10,59,104,70    :rem  main menu
  548.     blit savebuff,137,177,111,57,99,16:rect 113,59,207,70 :rem  pick
  549.     blit savebuff,137,177,111,74,99,16:rect 113,76,207,87 :rem  move
  550.     blit savebuff,137,177,214,57,99,16:rect 216,59,310,70 :rem  transp
  551.     blit savebuff,137,177,8,74,99,16:rect 10,76,104,87    :rem  load char
  552.     blit savebuff,137,177,214,74,99,16:rect 216,76,310,87 :rem  cont.
  553.     pen 1,0
  554.     center 1
  555.     margins 10,104:move 0,67:text "Main Menu"
  556.     margins 113,207:move 0,67:text "PICK OBJECT"
  557.     margins 10,104:move 0,85:text "LOAD CHAR"
  558.  
  559. 7201
  560.     if brselect:pen 1,0:else:pen 1,1:endif :rem  deselect move if no brush
  561.     center 1
  562.     margins 113,207:move 0,85:text "MOVE"
  563.     margins 216,310:move 0,67
  564.     if transon:pen 1,3:else:pen 1,0:endif
  565.     text "TRANSPARENT"
  566.     margins 216,310:move 0,85
  567.     if conton:pen 1,3:else:pen 1,0:endif
  568.     text "CONTINUOUS"
  569.     margins -1,-1
  570.     getmouse xm,ym
  571.     gosub checkbot
  572.     x=xm:y=ym
  573.     if x>8 & y>56 & x<102 & y<71    :rem  back to main 
  574.         pen 1,1:rect 8,57,312,106    :rem  erase upper buttons
  575.         return
  576.     endif
  577.     if x>214 & y>56 & x<312 & y<71        :rem  transparent toggle
  578.         transon=1-transon
  579.         goto 7201
  580.     endif
  581.     if x>214 & y>74 & x<308 & y<89    :rem  continuous toggle
  582.         conton=1-conton
  583.         goto 7201
  584.     endif
  585.     if x>111 & y>56 & x<205 & y<71    :rem  pick object
  586.         gosub getbrush                :rem  cutout a brush
  587.         display screen:gosub centscr
  588.         gosub 1100                    :rem  redisplay lower screen
  589.         if cancel=0:brselect=1:endif
  590.         goto 7201
  591.     endif
  592.     if x>8 & y>74 & x<107 & y<90        :rem  load char
  593.         string "Load Character",$(title)
  594.         name=tname:@(name)=0
  595.         gosub getfile
  596.         if fname 
  597.             mode=0:open mode,$(tname)
  598.             if mode=0
  599.                 string "Can't open save file",$(temp)
  600.                 gosub errmsg
  601.                 goto 7200
  602.             endif
  603.             gosub doread
  604.             if cancel:goto 7200:endif
  605.             compare t,"charsave",$(temp)
  606.             if t=0
  607.                 string "Not a character file!!",$(temp)
  608.                 gosub errmsg
  609.                 goto 7200
  610.             endif
  611.             gosub initfils        :rem  clear filent table
  612.             gosub doread
  613.             if cancel:goto 7200:endif
  614.             obuff=$(temp)
  615.             gosub doread
  616.             if cancel:goto 7200:endif
  617.             string $(temp),$(objname)
  618.             i=0
  619. 7222        j=filent+i*filentsz
  620.             gosub doread
  621.             if cancel:goto 7200:endif
  622.             compare t,".",$(temp)
  623.             if t:goto 7223:endif
  624.             t=$(temp)    :rem  get buff
  625.             @(j)=t
  626.             gosub doread
  627.             if cancel:goto 7200:endif
  628.             string $(temp),$(j+2)    :rem  get name
  629.             i=i+1
  630.             goto 7222
  631. 7223        gosub doread
  632.             if cancel:goto 7200:endif
  633.             charf=$(temp)    :rem  get number of char entries
  634.             if charf=0
  635.                 string "Empty character file!!",$(temp)
  636.                 gosub errmsg
  637.                 goto 7200
  638.             endif
  639.             for i=0 to charf-1
  640.                 v=charbase+i*charsiz
  641.                 for j=0 to charsiz-1
  642.                     gosub doread
  643.                     if cancel
  644.                         j=999
  645.                         i=charf
  646.                     else
  647.                         t=$(temp)
  648.                         @(v+j)=t
  649.                     endif
  650.                 next
  651.             next
  652.             if j=999:goto 7200:endif    :rem  end of file too soon
  653.             close
  654.             t=charbase+(charf-1)*charsiz    :rem  locate last brush
  655.             obuff=@(t)
  656.             xa=@(t+1)
  657.             ya=@(t+2)
  658.             xoff=@(t+3)
  659.             yoff=@(t+4)
  660.             wid=@(t+5)
  661.             hite=@(t+6)
  662.             for i=0 to totfiles-1
  663.                 j=filent+filentsz*i
  664.                 if @(j)=obuff
  665.                     string $(j+2),$(objname) :rem  get last brush filename
  666.                     i=totfiles
  667.                 endif
  668.             next
  669.             objbuf=3
  670.             free objbuf
  671.             mode=0:open mode,$(objname)
  672.             if mode=0
  673.                 string "Can't open ",$(temp)
  674.                 @(temp+11)=10
  675.                 string $(objname),$(temp+12)
  676.                 gosub errmsg
  677.                 goto 7200
  678.             endif
  679.             load objbuf,$(objname)
  680.             brselect=1
  681.         endif
  682.         goto 7200
  683.     endif
  684.     if 0=(x>111 & y>74 & x<205 & y<89)    :rem  not a move ?
  685.         goto 7200
  686.     endif
  687.  
  688.     if brselect=0:goto 7201:endif    :rem  no brush selected
  689.     objused=1
  690.     gosub saveobj
  691.  
  692. rem  make sure we've loaded a background
  693.     if bkgbuf=0:xm=147:ym=130:gosub 2000:endif
  694.  
  695. if helpa=0
  696.     pen 1,1:rect 8,57,312,106    :rem  erase upper buttons
  697.     pen 0,1:pen 1,0
  698.     center 0:move 12,86:text "Select starting then ending location";
  699.     pause 20
  700.     helpa=1        :rem  don't repeat this message
  701. endif
  702.  
  703.     outflag=0            :rem  flag don't write out blits directly
  704.     gosub putbrush        :rem  place down a brush
  705.     if cancel:goto 7200:endif    :rem  bail out
  706.  
  707. rem  now we have firstxt,firstyt,outxa,outya,outxt,outyt,outwid,outhite
  708.  
  709. 7202
  710.     gosub 1100
  711.     pen 1,1:rect 8,57,312,106    :rem  erase upper buttons
  712.     pen 0,1:pen 1,0
  713.     center 0:move 12,86:text "Number of frames to move?";
  714.     pen 1,3
  715.     input $(temp),10
  716.     if @(temp)=0:goto 7202:endif    :rem  don't accept return
  717.     steps = $(temp)
  718.     if steps=0:goto 7200:endif         :rem  no steps
  719.  
  720. 7203
  721.     pen 1,1:rect 8,57,312,106    :rem  erase upper buttons
  722.     pen 0,1:pen 1,0
  723.     center 0:move 12,86:text "Speed (0-? where 0 = fastest)?";
  724.     pen 1,3
  725.     input $(temp),10
  726.     if @(temp)=0:goto 7203:endif    :rem  don't accept return
  727.     aspeed = $(temp)
  728.  
  729.     gosub fileout
  730.  
  731. rem ************************************ write out move
  732. if firstmv=1
  733.     write
  734.     write " rem  uses buffers 1 and 2 for double buffering"
  735.     write " rem  requires 3 CHIP buffers plus one buffer for"
  736.     write " rem  each object file required"
  737.     write " rem  we will double buffer out of buffers 28 and 29"
  738.     write
  739.     write " setblack 1"
  740.     write " speed 1"
  741.     write " aspeed=";aspeed;"  :rem  adjust this to change speed"
  742. endif
  743. if newback
  744.     write 
  745.     write " bkbuf=";bbuff;"     :rem  number of background buffer"
  746.     write " load bkbuf,";$(quote);$(bkgname);$(quote)
  747.     if overscan
  748.         write " position -1,-1    :rem  adjust for overscan"
  749.     endif
  750.     newback=0    :rem  mark written.
  751. endif
  752.  
  753. for i=0 to totfiles-1    :rem  write all object loads
  754.     j=filent+i*filentsz
  755.     if @(j) # -1 & @(j+1) = 0
  756.         write
  757.         write " objbuf=";@(j);"    :rem  number of object buffer"
  758.         write " load objbuf,";$(quote);$(j+2);$(quote)
  759.         @(j+1)=1    :rem  mark written
  760.     endif
  761. next
  762.  
  763. if firstmv=1
  764.     write
  765.     write " new 28,bkbuf"
  766.     write " new 29,bkbuf"
  767.     write " copy bkbuf,28"
  768.     write " copy bkbuf,29"
  769.     write
  770.     write " display 28"
  771.     write " fade 1,-1,0"
  772.     write
  773.     write " buff=29"
  774.     write " blitdest buff"
  775.     write " goto 10"
  776.     write
  777.     write "rem  double buffer routine"
  778.     write "100    display buff"
  779.     write " display buff  :rem  to adjust timing for potential screen flash"
  780.     write " buff=57-buff"
  781.     write " blitdest buff"
  782.     write "  copy bkbuf,buff   :rem  setup next background"
  783.     write "  pause aspeed"
  784.     write " return"
  785.     write
  786.     write "10"
  787. endif
  788.     write "rem  ****** start of move #";firstmv;" ***********"
  789.     if transon:write " transparent 1":endif
  790. if charf=0
  791.     write " objbuf=";obuff
  792.     write " objx=";outxa
  793.     write " objy=";outya
  794.     write " objw=";outwid
  795.     write " objh=";outhite
  796.     write " xs=";firstxt
  797.     write " ys=";firstyt
  798.     write " xe=";outxt
  799.     write " ye=";outyt
  800.     write " st=";steps
  801.     write " xd=xe-xs"
  802.     write " yd=ye-ys"
  803.     write
  804.     if conton
  805.         write " for si=0 to st-1    :rem  -1 added by continuous"
  806.     else
  807.         write " for si=0 to st"
  808.     endif
  809.     write "  blit objbuf,objx,objy,xs+xd*si/st,ys+yd*si/st,objw,objh"
  810.     write "  gosub 100"
  811.     write " next"
  812. else 
  813.     xs=firstxt
  814.     ys=firstyt
  815.     xe=outxt
  816.     ye=outyt
  817.     xd=xe-xs
  818.     yd=ye-ys
  819.     c=0
  820.     ob=-9
  821.     for si=0 to steps
  822.         t=charbase+c*charsiz
  823.         if ob#@(t) 
  824.             ob=@(t)
  825.             write " objbuf=";ob
  826.         endif
  827.         tx=xs+xd*si/steps
  828.         ty=ys+yd*si/steps
  829.         tx=tx+(@(t+3)-xoff)
  830.         ty=ty+(@(t+4)-yoff)
  831. write " blit objbuf,";@(t+1);",";@(t+2);",";tx;",";ty;",";@(t+5);",";@(t+6);":gosub 100"
  832.         c=c+1
  833.         if c=charf:c=0:endif
  834.     next
  835. endif
  836.     if transon:write " transparent 0":endif
  837.     if conton
  838.         write " rem  copy -1,bkbuf    :rem  command removed by continuous"
  839.     else
  840.         write " copy -1,bkbuf    :rem  make final position permanent"
  841.     endif
  842.     write
  843.     write "rem ****** end of move #";firstmv;" **************"
  844.     write
  845.     firstmv=firstmv+1
  846.     moves=moves+1
  847. rem ************************************
  848.     close
  849.     goto 7200        :rem  back for more
  850.  
  851. rem  genchar
  852. 7300
  853.     gosub 1100    :rem  redisplay lower screen
  854.     pen 1,1:rect 8,57,312,106    :rem  erase upper buttons
  855.     blit savebuff,137,177,8,57,99,16:rect 10,59,104,70    :rem  main menu
  856.     blit savebuff,137,177,111,57,99,16:rect 113,59,207,70 :rem  pick
  857.     blit savebuff,137,177,111,74,99,16:rect 113,76,207,87 :rem  add object
  858.     blit savebuff,137,177,8,74,99,16:rect 10,76,104,87      :rem  new char
  859.     blit savebuff,137,177,214,57,99,16:rect 216,59,310,70 :rem  transp
  860.     blit savebuff,137,177,214,74,99,16:rect 216,76,310,87 :rem  del object
  861.     blit savebuff,137,177,214,91,99,16:rect 216,93,310,104 :rem save char
  862.     pen 1,0
  863.     center 1
  864.     margins 10,104:move 0,67:text "Main Menu"
  865.     move 0,85:text "NEW CHAR"
  866.     margins 113,207:move 0,67:text "PICK OBJECT"
  867.     margins 216,310:move 0,85:text "DEL OBJECT"
  868.     margins 216,310:move 0,102:text "SAVE CHAR"
  869.  
  870. 7301
  871.     if brselect:pen 1,0:else:pen 1,1:endif :rem  deselect add if no brush
  872.     center 1
  873.     margins 113,207:move 0,85:text "ADD OBJECT"
  874.     margins 216,310:move 0,67
  875.     if transon:pen 1,3:else:pen 1,0:endif
  876.     text "TRANSPARENT"
  877.     pen 1,0:margins -1,-1:center 0:move 12,102:text "Objects in char: ";
  878.     pen 1,2:text charf;"  ";
  879.     getmouse xm,ym
  880.     gosub checkbot
  881.     x=xm:y=ym
  882.     if x>8 & y>56 & x<102 & y<71    :rem  back to main 
  883.         pen 1,1:rect 8,57,312,106    :rem  erase upper buttons
  884.         return
  885.     endif
  886.     if x>8 & y>74 & x<102 & y<89    :rem  new char
  887.         charf=0
  888.         gosub initfils        :rem  clear remembered files
  889.         goto 7301
  890.     endif
  891.     if x>214 & y>56 & x<312 & y<71        :rem  transparent toggle
  892.         transon=1-transon
  893.         goto 7301
  894.     endif
  895.     if x>214 & y>74 & x<308 & y<89    :rem  del object
  896.         if charf:charf=charf-1:endif
  897.         goto 7301
  898.     endif
  899.     if x>111 & y>56 & x<205 & y<71    :rem  pick object
  900.         gosub getbrush        :rem  cutout a brush
  901.         display screen:gosub centscr
  902.         gosub 1100    :rem  redisplay lower screen
  903.         if cancel=0:brselect=1:endif
  904.         goto 7301
  905.     endif
  906.     if x>214 & y>91 & x<313 & y<107     :rem  save char
  907.         string "Save Character",$(title)
  908.         name=tname:@(name)=0
  909.         gosub getfile
  910.         if fname 
  911.             if objused:gosub saveobj:endif
  912.             mode=1:open mode,$(tname)
  913.             if mode=0
  914.                 string "Can't open save file",$(temp)
  915.                 gosub errmsg
  916.                 goto 7300
  917.             endif
  918.             write "charsave"
  919.             write obuff
  920.             write $(objname)
  921.             for i=0 to totfiles-1
  922.                 j=filent+i*filentsz
  923.                 if @(j)#-1
  924.                     write @(j)        :rem  write buff
  925.                     write $(j+2)    :rem  write name
  926.                 endif
  927.             next
  928.             write "."    :rem  end of filent table
  929.             write charf        :rem  number of char entries
  930.             for i=0 to charf-1
  931.                 t=charbase+i*charsiz
  932.                 for j=0 to charsiz-1
  933.                     write @(t+j)
  934.                 next
  935.             next
  936.             close
  937.         endif
  938.         goto 7300
  939.     endif
  940.     if 0=(x>111 & y>74 & x<205 & y<89)    :rem  not add to char?
  941.         goto 7300
  942.     endif
  943.  
  944.     if charf=totchars
  945.         string "Error: too many objects",$(temp)
  946.         gosub errmsg
  947.         goto 7300
  948.     endif
  949.  
  950. if charf=0
  951.     pen 1,1:rect 8,57,312,108    :rem  erase upper buttons
  952.     pen 0,1:pen 1,0
  953.     center 0:move 12,86:text "Place object in working position"
  954.     pause 20
  955.     if bkgbuf            :rem  dump background if any...
  956.         free bkgbuf
  957.         bkgbuf=0
  958.         @(bkgname)=0
  959.     endif
  960. endif
  961.  
  962.     outflag=2            :rem  flag don't write out blits directly
  963.     gosub putbrush        :rem  place down a brush
  964.     if cancel:goto 7300:endif    :rem  bail out
  965.  
  966. rem  now we have outxa,outya,outxt,outyt,outwid,outhite
  967.  
  968.     t=charbase+charf*charsiz
  969.     @(t)=obuff
  970.     @(t+1)=outxa
  971.     @(t+2)=outya
  972.     @(t+3)=outxt
  973.     @(t+4)=outyt
  974.     @(t+5)=outwid
  975.     @(t+6)=outhite
  976.     objused=1            :rem  we used this buffer
  977.  
  978.     xoff=outxt
  979.     yoff=outyt
  980.     charf=charf+1
  981.  
  982.     goto 7300
  983.  
  984. rem  centscr - center display for whatever size image we have.
  985. 7400
  986.  
  987.     x=ScreenX
  988.     y=ScreenY
  989.     resolution -1,xres,yres,depth
  990.     if xres>639
  991.         x=x-(xres-640)/4
  992.     else
  993.         x=x-(xres-320)/2
  994.     endif
  995.     if yres>399
  996.         y=y-(yres-NormHt*2)/4
  997.     else
  998.         y=y-(yres-NormHt)/2
  999.     endif
  1000.     position x,y
  1001.     if x#127 | y#43:os=1:else:os=0:endif
  1002.     return
  1003.  
  1004. rem  placbrsh - place brush over background
  1005. 7500
  1006.     cancel=0
  1007. rem  clone bkgbuf into altbuf
  1008.     new altbuf,bkgbuf    :rem  this could still blow out in hires overscan
  1009.     copy bkgbuf,altbuf
  1010.     display altbuf    :rem  we'll modify this one
  1011.     buff=bkgbuf
  1012.     x=0:y=0
  1013.  
  1014.     pointer 1
  1015. 7588 display buff:buff=(bkgbuf+altbuf)-buff
  1016.     pause 1
  1017.     ifkey char
  1018.     if char=13:goto 7589:endif        :rem  return
  1019.     if char=32:goto 7586:endif        :rem  space (more)
  1020.     if char=27:goto 7570:endif        :rem  escape (abort)
  1021.     if char=-101:goto 7587:endif
  1022.     ifmouse xt,yt:if xt=-1:goto 7588:endif
  1023.     x=xt:y=yt
  1024.  
  1025. 7580
  1026.     display altbuf
  1027.     copy bkgbuf,altbuf    :rem  erase old brush
  1028.     if transon:transparent 1:endif
  1029.     pen 0,0
  1030.     blit objbuf,xa,ya,x,y,wid,hite
  1031.     if transon:transparent 0:endif
  1032.     goto 7588
  1033.  
  1034. rem  abort
  1035. 7570 
  1036.     cancel=1
  1037.     goto 7571
  1038.  
  1039. rem  all done
  1040. 7589
  1041.     copy altbuf,bkgbuf    :rem  preserve mods
  1042. 7571
  1043.     transparent -1
  1044.     pointer 0
  1045.     display bkgbuf
  1046.     free altbuf
  1047.     xt=x:yt=y
  1048.     gosub outblit
  1049.     return
  1050.  
  1051. rem  new with same brush
  1052. 7586
  1053.     if outflag#1:goto 7589:endif    :rem  done if in move mode
  1054.     copy altbuf,bkgbuf
  1055.     xt=x:yt=y
  1056.     gosub outblit
  1057.     goto 7580
  1058.  
  1059. rem  arrow key?
  1060. 7587
  1061.     getkey char
  1062.     if char=67:x=x+1:goto 7580:endif
  1063.     if char=68:x=x-1:goto 7580:endif
  1064.     if char=66:y=y+1:goto 7580:endif
  1065.     if char=65:y=y-1:goto 7580:endif
  1066.     if char=84:y=y-10:goto 7580:endif
  1067.     if char=83:y=y+10:goto 7580:endif
  1068.     if char=32
  1069.         getkey char
  1070.         if char=65:x=x-10:endif
  1071.         if char=64:x=x+10:endif
  1072.         goto 7580
  1073.     endif
  1074.     goto 7588
  1075.  
  1076. rem  outblit    write blit command
  1077. 7600
  1078.     if outflag#1
  1079.         outxa=xa:outya=ya:outxt=xt:outyt=yt:outwid=wid:outhite=hite
  1080.         return
  1081.     endif
  1082.     gosub fileout        :rem  open output file
  1083.     if @(postfix)=0:@(postfix-1)=0:endif
  1084. if btype=1
  1085.     v=(wid*hite*depth)/128
  1086. write "DISSOLVE ";obuff;",";xa;",";ya;",";xt;",";yt;",";wid;",";hite;",";v;$(postfix-1)
  1087. endif
  1088.     if btype=2
  1089. write "BLIT ";obuff;",";xa;",";ya;",";xt;",";yt;",";wid;",";hite;$(postfix-1)
  1090.     endif
  1091.     if btype=3
  1092.         wpw=wid_hite
  1093. write "WIPE ";obuff;",";xa;",";ya;",";xt;",";yt;",";wid;",";hite;",";wpd;",";wpw;$(postfix-1)
  1094.     endif
  1095.     close
  1096.     blits=blits+1
  1097.     @(postfix-1)=colon
  1098.     return
  1099.  
  1100. rem initfils
  1101. 7800 for i=0 to totfiles-1
  1102.         j=filent+filentsz*i
  1103.         @(j)=-1    :rem  mark empty
  1104.         @(j+1)=0    :rem mark not written
  1105.     next
  1106.     return
  1107.  
  1108. rem saveobj
  1109. 7900
  1110.     i=0
  1111. 7901 if i#totfiles
  1112.         compare v,$(objname),$(filent+i*filentsz+2)
  1113.         if v    :rem  already in list?
  1114.             i=filent+i*filentsz
  1115.                 rem  don't update buff if allready written out
  1116.             if @(i+1)=0:@(i)=obuff:endif
  1117. goto 7909
  1118.             return
  1119.         endif
  1120.         i=i+1
  1121.         goto 7901
  1122.     endif
  1123.  
  1124.     i=0
  1125. 7902 if i#totfiles
  1126.         if @(filent+i*filentsz)#-1
  1127.             i=i+1
  1128.             goto 7902
  1129.         endif
  1130.     endif
  1131.     i=filent+i*filentsz        :rem  beginning of filent
  1132.  
  1133.     @(i)=obuff
  1134.     string $(objname),$(i+2)    :rem  save filename
  1135.  
  1136. 7909
  1137.     return
  1138.  
  1139. rem  diagnostic...
  1140. print "saveobj:"
  1141.  
  1142. for i=0 to totfiles-1
  1143.     j=filent+i*filentsz
  1144.     if @(j)#-1:print "  obuff=";@(j);" ";$(j+2):endif
  1145. next
  1146.     return
  1147.  
  1148. rem  doread
  1149. 8000
  1150.     cancel=0
  1151.     read t,$(temp),80
  1152.     if t=-1
  1153.         string "Save file error!!!",$(temp)
  1154.         gosub errmsg
  1155.         cancel=1
  1156.     endif
  1157.     return
  1158.  
  1159. rem  errmsg
  1160. 8100
  1161.     pen 1,1:rect 8,57,312,108    :rem  erase upper buttons
  1162.     pen 0,1:pen 1,0
  1163.     center 0:move 12,72
  1164.     margins 12,308:text $(temp)
  1165.     move 152,106:text "OK"
  1166.     pen 1,2:move 145,110:draw 145,96:draw 173,96
  1167.     pen 1,0:move 174,96:draw 174,110:draw 146,110
  1168. 8101
  1169.     getmouse x,y    :rem  await acknowledge
  1170.     if x>145 & x<174 & y>96 & y<110
  1171.         pen 1,1:rect 8,57,312,111:pen 1,0
  1172.         margins -1,-1
  1173.         return
  1174.     else
  1175.         rem  flash ok
  1176.         blitmode 102
  1177.         blit savebuff,116,139,146,97,28,13:pause 1 
  1178.         blit savebuff,116,139,146,97,28,13
  1179.         blitmode -1
  1180.         goto 8101
  1181.     endif
  1182.  
  1183.